perm filename MARKX.SAI[X,ALS] blob
sn#082469 filedate 1974-01-18 generic text, type T, neo UTF8
00010 BEGIN "MARKX"
00020 DEFINE ⊂="COMMENT"; ⊂ NOV.26,1973;
00030 ⊂ This program is a very simple pitch marking routine to be used to
00040 suppliment Neil's routine in certain cases;
00050 DEFINE ⊃="⊂";
00060 DEFINE CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
00070 REQUIRE "DPYSUB.HDR[1,PDQ]" SOURCE_FILE;
00080 LABEL STARTP,STOPP,TOFORM;
00090 DEFINE \=" "; ⊂ DEFINE \="SAFE"; ⊂ Alternarte definitions;
00100 INTEGER SUM,SUMM,SUMP,MAX,MIN,
00110 SUMREF,SUMSAV,SUMMIN,SUMMAX,SUMOLD;
00120 INTEGER MAXOLD,MINOLD,MARGIN,PER,PERMIN,PERMAX;
00130 INTEGER QOLD,QSAVE,QREF,QOLD2;
00140 INTEGER ZEROC,ZEROF,DX;
00150 EXTERNAL INTEGER INFLAG,NX;
00160 \ INTERNAL INTEGER ARRAY D[0:767];
00170 REAL X,SX; \ REAL ARRAY WINDOW[0:512];
00180 INTERNAL REAL R0;
00190 INTEGER LPCOPT;
00200 \ INTEGER ARRAY DPYBUF[0:1535];
00210 \ INTERNAL INTEGER ARRAY FVAL,NVAL[0:8];
00220 \ EXTERNAL INTEGER ARRAY NEW[0:512];
00230 INTEGER FX;
00240 INTEGER I,J,K,L,P,PP,Q,QQ,R,DK,DDK,DDDK,DVAL,DDVAL,DDDVAL,ALPHA,
00250 POINTF,POINTX,STATE,DELTA,DELTN,VAL,CHAN1,EOF,POINTT,POINTV;
00260 INTERNAL INTEGER M,N,PERIOD;
00270 INTEGER PT0,PT1,PT2,X0,X1,Y0,Y1,X2,Y2,
00280 PTCNT,PICK,JP,JPP,JPX,OPT,OPT1,SHUFCT;
00290 INTEGER II,JJ,KK,NN,SEGC,BRK,EOFA,EOFT,EOFTF,READ3,LFX,PITX,PITY,
00300 SEGTOT,SEGIN,KKT,NNT,ITT,JTT,KTT;
00310 BOOLEAN ER;
00320 INTEGER CHAN2,CHAN3,CHAN4,CHAN6,CHANX;
00330 INTERNAL INTEGER CHAN5;
00340 \ INTEGER ARRAY BUF,BUFT,BUFTT[0:511];
00350 STRING FILEN,FILEF,READ,READ1,READT,
00360 READTT,FILEO,READ2,FILEQ,TFILE,FILLST,FILEP;
00361
00362 INTEGER ARRAY QRES,SUMRES,SPAN[0:3];
00363 INTEGER QX;
00364
00370
00380 PROCEDURE OUTALL(STRING S);
00390 BEGIN
00400 STRING SS; INTEGER J;
00410 SETBREAK(18,0,NULL,"OSN");
00420 SS←SCAN(S,18,J);
00430 OUTSTR(SS);
00440 END;
00450
00460 PROCEDURE DATAIN;
00470 BEGIN
00480 INTEGER J;
00490 FOR J←0 STEP 1 UNTIL 511 DO BUF[J]←0;
00500 ⊂ IF EOF=0 THEN OUTSTR("BUF") ELSE OUTSTR(" EOF ");
00510 IF EOF=0 THEN ARRYIN(CHAN1,BUF[0],512);
00520 ⊂ IF EOF=0 THEN OUTSTR(" New BUF ") ELSE OUTSTR(" EOF ");
00530 POINTX←POINT(12,BUF[0],-1);
00540 SEGC←II←II+12; JJ←II+11;
00550 END;
00560
00570
00580 PROCEDURE DTTTIN;
00590 BEGIN
00600 INTEGER J;
00610 IF EOFT=0 THEN ARRYIN(CHAN3,BUFTT[0],512)
00620 ELSE OUTSTR
00630 ("No more .P data with JJ= "&CVS(JJ)&"SEGC= "&CVS(SEGC)&CRLF);
00640 FOR J←0 STEP 1 UNTIL 511 DO IF BUFTT[J]=0 THEN BUFTT[J]←'377777777777;
00650 ITT←BUFTT[0] LSH -15; KTT←0; JTT←BUFTT[511] LSH -15;
00660 ⊂ FOR J←0 STEP 1 UNTIL 10 DO OUTSTR(CVOS(BUFTT[J])&TB);
00670 END;
00680
00690
00700 PROCEDURE DATOUT;
00710 BEGIN "DATOUT"
00720 INTEGER I,J;
00730
00740 ARRYOUT(CHAN5,BUFT[0],512);
00750 FOR I←0 STEP 1 UNTIL 511 DO BUFT[I]←0;
00760 END "DATOUT";
00770
00780
00790 PROCEDURE MARK;
00800 BEGIN "MARK"
00810 INTEGER I,JJ,K,L,JJP,LP,PT2;
00820
00830 RIVECT(0,-130); SETFORMAT(3,0);
00840 FOR I←0 STEP 20 UNTIL 340 DO BEGIN
00850 DPYSST(CVS(I)); RIVECT(15,0); END;
00860 RIVECT(-555,30); RIVECT(-500,0);
00870
00880 FOR I←0 STEP 100 UNTIL 300 DO BEGIN "HUNDRED"
00890 RIVECT(0,30); RVECT(0,-30);
00900 FOR JJ←0 STEP 50 UNTIL 50 DO BEGIN "FIFTY"
00910 FOR K←1 STEP 1 UNTIL 5 DO BEGIN "TEN"
00920 RIVECT(15,0); RVECT(0,5); RIVECT(0,-5);
00930 RIVECT(15,0); RVECT(0,10);RIVECT(0,-10);
00940 END "TEN";
00950 RVECT(0,20); RIVECT(0,-20);
00960 IF I≥300 THEN DONE "HUNDRED";
00970 END "FIFTY";
00980 END "HUNDRED";
00990 RIVECT(-550,100); RIVECT(-500,0);
01000
01010 K←D[0]%8; RIVECT(0,K);
01020 FOR I←1 STEP 1 UNTIL 350 DO BEGIN
01030 JJP←D[I]%8;
01040 LP←JJP-K; RVECT(3,LP); K←JJP; END;
01050 RIVECT(-550,-K); RIVECT(-500,0);
01060
01070 RIVECT(500,0);
01080 FOR JJ←1 STEP 1 UNTIL 2 DO IF FVAL[JJ]≤375 THEN BEGIN
01090 L←3*FVAL[JJ]-500;
01100 RIVECT(L,120); RVECT(0,-70); RIVECT(0,-25); RVECT(0,-25);
01110 RIVECT(-25,0); RVECT(50,0);
01120 RIVECT(-25,0); RIVECT(-L,0); END;
01130
01140 FOR JJ←1 STEP 1 UNTIL 3 DO IF NVAL[JJ]≤375 THEN BEGIN
01150 L←3*NVAL[JJ]-500;
01160 RIVECT(L,0);RIVECT(-25,0); RVECT(50,0);
01170 RIVECT(-25,0); RVECT(0,-120); RIVECT(-L,120); END;
01180
01190 RIVECT(-500,0);
01200 DPYOUT(0); PTOCHW(0,'10120); SETFORMAT(1,0);
01207
01210
01220 END "MARK";
01230
01240 INTERNAL PROCEDURE CALCOMP(STRING FILE;INTEGER ARRAY BUFR);
01250 ⊃ Outputs display buffer BUFR to disk file FILE in a format
01260 readable by the Nealy Calcomp plotter program PLTVEC, and by
01270 the Quam Video Synthesizer program MIRTOP;
01280 IF FILE THEN
01290 BEGIN INTEGER DSIZ,CCCHN;
01300 OPEN(CCCHN←GETCHAN,"DSK",'14,0,1,0,0,0);
01310 ENTER(CCCHN,FILEN&".GRF",0);
01320 DPYPARS;DSIZ←BUFR[1]+4;
01330 ARRYOUT(CCCHN,BUFR[0],2);WORDOUT(CCCHN,0);
01340 ARRYOUT(CCCHN,BUFR[2],DSIZ-2);
01350 RELEASE(CCCHN);
01360 END "CALCOMP";
01370
01380
01390 PROCEDURE PITCH;
01400 BEGIN "PITCH"
01410
01420 CASE STATE OF BEGIN
01430
01440 ⊂ STATE 0 INDETERMINATE STATE;
01450 IF VAL>0 THEN
01460 BEGIN OUTSTR(CVS(STATE)&" ");
01470 STATE←1; SUM←MIN←0; SUMP←MAX←VAL;
01480 QOLD←QQ;
01490 END;
01500
01510 ⊂ STATE 1 INITIAL POSITIVE STATE;
01520 IF VAL≤0 THEN
01530 BEGIN
01540 IF (SUMOLD<DELTA*2)∧(SUMP<MARGIN) THEN STATE←0 ELSE
01550 BEGIN OUTSTR(CVS(STATE)&" ");
01560 STATE←4; SUM←SUMOLD+SUMP-VAL;
01570 MAX←MAXOLD; MIN←MINOLD;
01580 IF VAL<MIN THEN MIN←VAL;
01590 END;
01600 END ELSE
01610 BEGIN
01620 SUMP←SUMP+VAL;
01630 IF VAL<ALPHA THEN BEGIN SUMP←VAL; QOLD←QQ-1; END;
01640 IF VAL>MAX THEN MAX←VAL;
01650 IF SUMP>DELTA THEN
01660 BEGIN OUTSTR(CVS(SUMREF)&" "&CVS(SUMSAV)&" "&CVS(SUMOLD)&" ");
01670 STATE←2; SUM←SUMP;
01680 P←0;
01690 IF SUMSAV=SUMREF ∧ (PER≥PERIOD*3%2∨SUMOLD>SUMREF) THEN P←1 ELSE
01700 IF SUMOLD≤SUMSAV THEN SUMSAV←SUMOLD ELSE
01710 IF PER>PERIOD*3%2 THEN P←2 ELSE
01720 IF (SUMOLD≥SUMREF*3%4) ∧ PER≥PERIOD*3%4 THEN P←3 ELSE
01730 IF (PER≥PERIOD*7%8)∧(SUMOLD≥SUMREF%4) THEN P←4;
01750
01760 ⊂ OUTSTR(CVS(PITX)&" QREF="&CVS(QREF)&" REF="&CVS(SUMREF)&" OLD="&CVS(SUMOLD)
01770 &" SAV="&CVS(SUMSAV)&" STATE="&CVS(STATE)&" P="&CVS(P)
01780 &" QQ="&CVS(QQ)&" PER="&CVS(PER)&CRLF);
01781
01782 IF (P=0)∧(PER≥PERIOD*4%5)∧(PER≤PERIOD*5%4) THEN BEGIN
01783 QRES[QX]←QSAVE; SPAN[QX]←MAXOLD-MINOLD; SUMRES[QX]←SUMOLD;
01784 OUTSTR("QRES[QX]="&CVS(QRES[QX])&" "); IF QX<3 THEN QX←QX+1; END;
01785
01790 IF P≥1 THEN
01800 BEGIN
01802 WHILE (BUFT[PITX-1] LSH -15)≥QSAVE DO BEGIN
01806 PITX←PITX-1; QREF←QREF-PERIOD; END;
01808
01810 BUFT[PITX]←(QSAVE LSH 15)+((SUMOLD LSH -6) LAND '77770)+P;
01815 OUTSTR("QREF="&CVS(QREF)&" QSAVE="&CVS(QSAVE)&" P="&CVS(P)&" "&"PERIOD="&CVS(PERIOD)&" ");
01820 SUMREF←SUMOLD; PER←QSAVE-QREF; QREF←QSAVE;
01830 ⊂ IF SUMREF<SUMMIN THEN SUMREF←SUMMIN;
01840 IF P≠1 THEN PERIOD←(2*PERIOD+PER)%3;
01850 IF PERIOD<PERMIN THEN PERIOD←PERMIN ELSE
01860 IF PERIOD>PERMAX THEN PERIOD←PERMAX;
01870 IF (PITX←PITX+1)≥512 THEN DATOUT;
01880 JPP←0;
01881
01882 FOR QX←0 STEP 1 UNTIL 3 DO SPAN[QX]←0; QX←0;
01890 END ELSE IF PER>PERIOD*3%2 THEN
01891 BEGIN
01892
01893 K←0; FOR I←0 STEP 1 UNTIL 3 DO
01894 IF SPAN[I]>K THEN BEGIN K←SPAN[I]; QX←I; END;
01895 IF K≠0 THEN BEGIN
01896 BUFT[PITX]←(QRES[QX] LSH 15)+((SUMRES[QX] LSH -6) LAND '77770)+7;
01897 OUTSTR("QRES="&CVS(QRES[QX])&" ");
01898 SUMREF←SUMRES[QX]; PER←QRES[QX]-QREF; QREF←QRES[QX];
01899 PERIOD←(2*PERIOD+PER)%3; END;
01900 END;
01905
01910 END;
01920 END;
01930
01940 ⊂ STATE 2 CONFIRMED POSITIVE STATE;
01950 IF VAL>0 THEN
01960 BEGIN
01970 SUM←SUM+VAL; IF VAL>MAX THEN MAX←VAL;
01980 END ELSE
01990 BEGIN OUTSTR(CVS(STATE)&" ");
02000 STATE←3; SUMM←-VAL; MIN←VAL;
02010 END;
02020
02030 ⊂ STATE 3 INITIAL NEGATIVE STATE;
02040 IF VAL>0 THEN
02050 BEGIN
02060 IF SUM<MARGIN THEN STATE←0 ELSE
02070 BEGIN OUTSTR(CVS(STATE)&" ");
02080 STATE←2; SUM←SUM+SUMM+VAL;
02090 IF VAL>MAX THEN MAX←VAL;
02100 END;
02110 END ELSE
02120 BEGIN
02130 SUMM←SUMM-VAL;
02140 IF VAL<MIN THEN MIN←VAL;
02150 IF SUMM>DELTN THEN
02160 BEGIN OUTSTR(CVS(STATE)&" ");
02170 STATE←4; SUM←SUM+SUMM;
02180 END;
02190 END;
02200
02210 ⊂ STATE 4 CONFIRMED NEGATIVE STATE;
02220 IF VAL≤0 THEN
02230 BEGIN
02240 SUM←SUM-VAL; IF VAL<MIN THEN MIN←VAL;
02250 END ELSE
02260 BEGIN OUTSTR(CVS(STATE)&" ");
02270 STATE←1; QSAVE←QOLD; SUMSAV←SUMOLD; SUMOLD←SUM; PER←QSAVE-QREF;
02280 MAXOLD←MAX; MINOLD←MIN;
02290 min←sum←0;
02300 SUMP←MAX←VAL; QOLD←QQ;
02310 END;
02320
02330 END;
02340 ⊂ OUTSTR("State="&cvs(state)&" VAL="&CVS(VAL)&" PITX="&CVS(PITX)&
02350 " PITX="&CVS(PITX)&" SUM="&CVS(SUM)&" SUMP="&CVS(SUMP)&
02360 " SUMM="&CVS(SUMM)&" SUMOLD="&CVS(SUMOLD)&" SUMREF="&CVS(SUMREF)&CRLF);
02370 QQ←QQ+1;
02380
02390 IF ((QQ-QREF)≥PERIOD*2) THEN BEGIN OUTSTR(CVS(STATE)&" ");
02400 BUFT[PITX]←(QREF+PERIOD) LSH 15;
02410 ⊂ OUTSTR("B "&CVS(PITX)&" QREF="&CVS(QREF)&" REF="&CVS(SUMREF)&" OLD="&CVS(SUMOLD)
02420 &" SAV="&CVS(SUMSAV)&" STATE="&CVS(STATE)&" QQ="&CVS(QQ)
02430 &" PER="&CVS(PER)&CRLF);
02440 PITX←PITX+1; QREF←QREF+PERIOD; STATE←SUM←0;
02450 END;
02460 END "PITCH";
00010 FILEN←"HI20.001[CMP,VIN]";
00020 FILEO←"SEG1.ALS[SYN,ALS]";
00030 PERIOD←180; PERMAX←220; PERMIN←100; MARGIN←50; DELTA←900; DELTN←50; QQ←0;
00040 SUMMIN←200; ALPHA←40;
00050
00060 STDBRK(1);
00070 SETBREAK(14,"∃",NULL,"INS");
00080 SETBREAK(15,'11&'12&'14&'15&'40,NULL,"INS");
00090 SETBREAK(16,'56,NULL,"INA");
00100 SETBREAK(17,'12,'15,"INS");
00110
00120 CHAN1←1; CHAN2←2; CHAN3←3; CHAN4←4; CHAN5←5; CHAN6←6;
00130 OUTSTR("This program generates a file of pitch markers similar to "&
00140 "the .P files"&CRLF&" but with extension of .ALS."&CRLF);
00150 OUTSTR("At present this program takes acoustic data from [CMP,VIN],"&
00160 CRLF&TB&"and pulse informstion from .P[PIT,NJM] files"&CRLF&TB&CRLF&LF);
00170
00180
00190 STARTP:
00200
00210 OUTSTR(CRLF&"Type number of file to start (CR only for 1) ");
00220 IF (READ←INCHWL)="" THEN PP←1 ELSE PP←CVD(READ);
00230 OUTSTR("Start display with sample # (CR for first phone) ");
00240 IF (READ←INCHWL)="" THEN JPP←1 ELSE BEGIN JPP←0; JP←CVD(READ); END;
00250
00260 ⊂ Begin FILEREAD;
00270 FOR PP←PP STEP 1 UNTIL 26 DO BEGIN "FILEREAD"
00280 CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,2,0,0,0,EOF);
00290 SETFORMAT(-3,0); FILEQ←CVS(PP);
00300 FILEN←FILEN[1 TO 5]&FILEQ&"[CMP,VIN]";
00310 LOOKUP(CHAN1,FILEN,ER); TFILE←FILEN;
00320 WHILE ER DO BEGIN
00330 IF PP>1 THEN BEGIN OUTSTR("Out of data, will terminate."&CRLF);
00340 GOTO STOPP; END;
00350 OUTSTR(CRLF&"Can not find file "&TFILE&" File= ");
00360 LOOKUP(CHAN1,TFILE←INCHWL,ER); END;
00370 J←K←L←STATE←VAL←0; R←-1;
00380 SETFORMAT(1,0); FILEQ←CVS(PP); JP←FVAL[0]←1000; R←-1; CLRBUF;
00390 II←-11; JJ←-1;
00400
00410 DATAIN; SUMREF←SUMOLD←SUMSAV←SUMMIN;
00420 PITX←0; BUFT[PITX]←1; PITX←1;
00430 FOR J←0 STEP 1 UNTIL 767 DO BEGIN
00440 VAL←ILDB(POINTX); IF VAL>2047 THEN VAL←VAL-4096;
00450 D[J]←VAL; PITCH; END;
00460 SEGIN←6; FVAL[1]←FVAL[2]←0;
00470
00480
00490 FILEP←FILEO[1 TO 3]&FILEQ&".ALS[SYN,ALS]";
00500 CLOSE(CHAN5); OPEN(CHAN5,"DSK",'14,0,2,0,0,0);
00510 ENTER(CHAN5,FILEP,0);
00520 OUTSTR("File "&FILEP&" has been opened"&CRLF);
00530
00540
00550 READ2←FILEP;
00560 READTT←SCAN(READ2,16,J)&"P[PIT,NJM]";
00570 ⊂ OUTSTR(READTT&CRLF);
00580 CLOSE(CHAN3); OPEN(CHAN3,"DSK",'10,10,0,0,0,EOFT);
00590 LOOKUP(CHAN3,READTT,ER); TFILE←READTT;
00600 IF ER THEN BEGIN
00610 OUTSTR("File "&READTT&" not found (S to start, space bar to ignore) ");
00620 IF (READ1←INCHRW)="S" THEN GOTO STARTP ELSE BEGIN
00630 BUFTT[0]←'77777; BUFTT[1]←'377777700000;ITT←0; JTT←'3777777;
00640 CLRBUF; END; END;
00650
00660 FOR I←1 STEP 1 UNTIL 8 DO FVAL[I]←0; FVAL[0]←10000;
00670 DTTTIN;
00680 FVAL[4]←BUFTT[0]; FVAL[1]←(FVAL[4] LSH -15)-(SEGIN-6)*128;
00690 FVAL[5]←BUFTT[1]; FVAL[2]←(FVAL[5] LSH -15)-(SEGIN-6)*128;
00700 FVAL[6]←BUFTT[2]; FVAL[3]←(FVAL[6] LSH -15)-(SEGIN-6)*128;KTT←2;
00710 NVAL[5]←BUFT[0]; NVAL[2]←(NVAL[5] LSH -15)-(SEGIN-6)*128;
00720 NVAL[6]←BUFT[1]; NVAL[3]←(NVAL[6] LSH -15)-(SEGIN-6)*128; PITY←1;
00730
00740
00750
00760
00770 ⊂ Begin "GET";
00780
00790 WHILE TRUE DO BEGIN "GET"
00800
00810
00820 ⊂ OUTSTR("JTT="&CVS(JTT)&TB&"J="&CVS(J)&CRLF);
00830 IF JJ<SEGIN THEN IF EOF≠0 THEN DONE "GET" ELSE DATAIN;
00840
00850 ⊂ OUTSTR("JJ="&CVS(JTT)&TB&"J="&CVS(J)&"before DTTTIN");
00860 IF JTT<(SEGIN-1)*128 THEN DTTTIN;
00870 ⊂ OUTSTR(" and after JTT="&CVS(JTT)&CRLF);
00880
00890 ⊂ FVAL and NVAL assignments (NVAL are newly computed values)
00900 [1] DELTA FOR FIRST MARKER
00910 [2] DELTA FOR SECOND MARKER
00920 [3] DELTA FOR THIRD MARKER
00930 [4] PULSE DATE FOR FIRST MARKER
00940 [5] PULSE DATA FOR SECOND MARKER
00950 [6] PULSE DATA FOR THIRD MARKER;
00960
00970
00980 NVAL[1]←NVAL[2]; NVAL[4]←NVAL[5];
00990
01000 WHILE NVAL[1]>127 DO BEGIN
01010 IF SEGIN≥JJ THEN IF EOF≠0 THEN DONE "GET" ELSE DATAIN;
01020 FOR Q←0 STEP 1 UNTIL 639 DO D[Q]←D[Q+128];
01030 FOR Q←640 STEP 1 UNTIL 767 DO BEGIN
01040 VAL←ILDB(POINTX); IF VAL>2047 THEN VAL←VAL-4096;
01050 D[Q]←VAL; PITCH; END; SEGIN←SEGIN+1; ⊂ OUTSTR("RELOAD"&CRLF);
01060 FVAL[1]←FVAL[1]-128; FVAL[2]←FVAL[2]-128; FVAL[3]←FVAL[3]-128;
01070 NVAL[1]←NVAL[1]-128; NVAL[3]←NVAL[3]-128; END;
01080
01090 WHILE FVAL[1]<0 DO BEGIN FVAL[1]←FVAL[2]; FVAL[2]←FVAL[3];
01100 FVAL[4]←FVAL[5]; FVAL[5]←FVAL[6];
01110 KTT←KTT+1; IF KTT≥512 THEN DTTTIN;
01120 FVAL[6]←BUFTT[KTT];
01130 FVAL[3]←(FVAL[6] LSH -15)-(SEGIN-6)*128;END;
01140
01150 NVAL[2]←NVAL[3]; NVAL[5]←NVAL[6];
01160 PITY←PITY+1;
01170 NVAL[6]←BUFT[PITY];
01180 NVAL[3]←(NVAL[6] LSH -15)-(SEGIN-6)*128;
01190
01200 ⊂ OUTSTR(CVS(FVAL[1])&TB&CVS(FVAL[2])&TB&CVS(FVAL[3])&
01210 TB&CVS(FVAL[4] LSH -15)&TB&
01220 CVS(FVAL[5] LSH -15)&TB&CVS(FVAL[6] LSH -15)&CRLF);
01230 ⊂ OUTSTR(CVS(NVAL[1])&TB&CVS(NVAL[2])&TB&CVS(NVAL[3])&
01240 TB&CVS(NVAL[4] LSH -15)&TB&
01250 CVS(NVAL[5] LSH -15)&TB&CVS(NVAL[6] LSH -15)&CRLF);
01260
01270 ⊂ OUTSTR(CRLF&CVS(SEGIN)&TB&CVS(FVAL[1])&TB&CVS(FVAL[2])&TB&CVS(FVAL[3])&TB&
01280 CVS(FVAL[4] LSH -15)&
01290 " "&CVS(FVAL[5] LSH -15)&" "&CVS(FVAL[6] LSH -15)&TB&TB);
01300
01310
01320 R←R+1; OUTSTR(CVS(NVAL[4] LSH -15)&TB); IF (R MOD 10)=9 THEN OUTSTR(CRLF);
01330
01340
00010 JP←JP-1; READ1←INCHRS;
00020 IF (READ1="F")∨(READ1="f") THEN BEGIN CLRBUF; READ1←"";
00030 JP←-10; OUTSTR(CRLF&LF&"Will stop at the end of this file"&CRLF&LF); END;
00040 IF (READ1="E")∨(READ1="e") then goto stopp;
00050
00060 IF (READ1=" ")∨(JPP=0) THEN BEGIN "SHOW"
00070 ⊂ IF (READ1=" ")∨((ABS(FVAL[1]-NVAL[1])>5)∨(ABS(FVAL[2]-NVAL[2])>5)) THEN
00080 BEGIN "SHOW";
00090 TYPLOC(512,170); DPYSET(DPYBUF);
00100 JP←1;
00110 OUTSTR(CRLF&"File "&FILEN&TB);
00120 OUTSTR("from "&CVS(NVAL[4] LSH -15)
00130 &" to "&CVS(NVAL[5] LSH -15)&TB&CVOS(NVAL[4] LAND '77777)&","&
00140 CVOS(NVAL[5] LAND '77777)&TB&CVS(SUMREF)&CRLF);
00150 AIVECT(-599,0);MARK;
00160 DPYOUT(0);PTOCHW(0,'10120);
00170 ⊂ OUTSTR("Type P for XGP copy file or type next command.");
00180 ⊂ OUTSTR("Space to run, LF for next, # for sample #, +# to add periods."&CRLF);
00190
00200 READ1←INCHRW;
00210 WHILE (READ1="W")∨(READ1="w") DO BEGIN DPYOUT(0) ;
00220 PTOCHW(0,'10120);READ1←INCHRW; END;
00230 IF (READ1="P")∨(READ1="p") THEN BEGIN CALCOMP("PLOTX",DPYBUF);
00240 OUTSTR("EX DPYXGP[X,ALS] plots PLOTX.GRF on the XGP. Next command please."&CRLF);
00250 READ1←INCHRW; END;
00260 K←CVASC(READ1); OPT1←0;
00270
00280 IF K=CVASC("+") THEN BEGIN
00290 JP←CVD(INCHWL); FVAL[0]←10000; END;
00300 IF K≥CVASC("0") THEN IF K≤CVASC("9") THEN BEGIN
00310 FVAL[0]←INCHWL; JP←10000; END;
00320 IF READ1=" " THEN FVAL[0]←JP←10000;
00330 IF(READ1="F")∨(READ1="f") THEN JP←-1;
00340 IF (READ1="E")∨(READ1="e") THEN GOTO STOPP;
00350
00360 IF (READ1='15)∨(READ1='12) THEN BEGIN JP←1; CLRBUF; END;
00370
00380 TOFORM:
00390 IF (READ1="S")∨(READ1="s") THEN JP←JP+1;
00400 IF (READ1="E")∨(READ1="e") THEN GOTO STOPP;
00410 PTOCHW(0,'10103); CLRBUF; TYPLOC(512,-170); PTOCHW(0,'10120);
00420 END "SHOW";
00430
00440
00450 END "GET";
00460 CLOSE(CHAN1); CLOSE(CHAN3);
00470 DATOUT; CLOSE(CHAN5);
00480 IF JP<0 THEN DONE;
00490 END "FILEREAD";
00500
00510 OUTSTR("Data are exhausted"&CRLF&LF);
00520 STOPP: PTOCHW(0,'10103); PTOCHW(0,'10120);
00530 CLOSE(CHAN1);CLOSE(CHAN2);CLOSE(CHAN3);
00540 CLOSE(CHAN4);CLOSE(CHAN5);CLOSE(CHAN6);
00550
00560 END "MARKX";
00570